parse arg args;options cache;options failat 99;options results;signal on break_c;signal on break_d;signal on break_e;signal on break_f;signal on halt;signal on ioerr;signal on syntax;address 'MAILMANAGER';Main:;call Init;call Header;call Parse_Args(args);call Read_Cfg;if system.arg.gui then Show;select;when system.arg.encode then call Encode;when system.arg.decode then call Decode(system.arg.area, system.arg.msg);otherwise signal Usage;end;call Quit(0, 'All done.');exit;Add_Text: procedure Expose msg.;parse arg line;MM_AddToStem 'msg.text' 'line';return;break_c:; break_d:; break_e:; break_f:; halt:;return_code = 5;error_line = 0;error_msg = 'Execution halted!!!';rc = 0;signal Exit;Check_Pattern: procedure Expose result;arg pattern, string.0;string.count = 1;result. = 0;MM_SearchInStem 'string' 'result' pattern 'STR';result = result.0;return result.count>0;Command: procedure Expose system.;parse arg cmd, noreq;address command cmd; ret = rc;if noreq~=1 & ret>0 then do
call Log('*** WARNING: Command "'cmd'" returned' ret'.');if system.arg.gui then call Request_Choice('\c\n* * * W A R N I N G * * *\n\n"' || cmd'"\n\nreturned' ret'!\n', '* _OK ', '_');end;return rc;Decode: procedure Expose system.;arg area, nr;deldir = 'c:delete >NIL:' system.tmpdir 'all quiet noreq force';call Command(deldir, 1);if ~makedir(strip(system.tmpdir, 't', '/ ')) then call Quit(31, 'Unable to create tmpdir "'system.tmpdir'"!!!');call Search_Encoded_Files(area, nr, 0, 0);call delete(system.tmpfile);call Command('c:list >'system.tmpfile system.tmpdir 'lformat "%n %l"');MM_ReadStem system.tmpfile 'tmp';call delete(system.tmpfile);file. = 0;len. = 0;note = 'From:' msg.from '%' msg.fromaddr'; Area:' area;do n=0 to tmp.count-1;parse var tmp.n fl ln .;file.max = max(file.max, length(fl)+2);file.n = fl;len.max = max(len.max, length(ln));len.n = ln;from = system.tmpdir || fl;to = system.prg.dir || fl;MM_SetFileNote from 'note';if exists(to) then MM_MoveFile to to;MM_MoveFile from to
call Log('Decoded:' fl ln 'bytes');end;file.count = tmp.count;len.count = tmp.count;call Command(deldir);if system.arg.gui then do;if file.count>0 then do;if n>1 then tmp = 's were';else tmp = ' was';text = '\c\nThe following file'tmp 'decoded from\narea' area', msg #'nr 'to "'system.prg.dir'":\n\n';end;else text = '\c\nThere were no uuencoded files in this msg!!!\n';do n=0 to file.count-1;text = text'\1'left(file.n, file.max) || right(len.n, len.max) 'bytes\0\n';end;call Request_Choice(text, '* _OK ', '_');end;if system.ok & system.clearnew then do;flags = 'READ';do n=0 to system.msg.count-1;MM_EditMsgFlags area system.msg.n 'flags';end;MM_Free area;end;return;Decode_File: procedure Expose system.;parse arg mode, file;olddir = pragma('d', system.tmpdir);call Log('Decoding' mode'-encoded file...',, 4);ret = Command(system.cmd.mode.decode);call pragma('d', olddir);return ret;Encode: procedure Expose system.;call Get_Datas;call Send_File(system.arg.mode);return;Exit:;select
when return_code>=40 then error = 'INTERNAL-ERROR:';when return_code>=30 then error = 'IO-ERROR:';when return_code>=20 then error = 'ERROR:';when return_code>=10 then error = 'WARNING:';when return_code>=5 then error = 'INFO:';otherwise error = '';end;if system.arg.gui & return_code>5 then do;tmp = center(error_msg, max(length(error_msg), 40));call Request_Choice('\c\n'error'\n\n\1'tmp'\0\n', '* _OK ', '_');end;call Log(,, 3);call Log('***' strip(error error_msg) '***', '+');call Log(,'\',, 3);call setclip('MM_LogPre', system.mm.logpre);exit return_code;Expand_Path: procedure;parse arg path;if pos(':', path)+pos('/', path)=0 then path = path(pragma('d')) || path;return path;Get_Addr: procedure Expose msg. system.;if msg.area.data.type~='MAIL' then return '';parse arg text;ok = 0;tmp = '';do while ok=0;tmp = Request_String(text, tmp, 1);parse var tmp z ':' nt '/' nd '.' p '@' d '.' .;ok = datatype(z, 'N') & datatype(nt, 'N') & datatype(nd, 'N') & datatype(p, 'N') & datatype(d, 'A') & upper(d)=msg.domain
addr = tmp;end;return addr;Get_Arg: procedure Expose args system.;arg keyword, mode, old;uargs = upper(args);p = find(uargs, keyword);if p=0 then do;p = pos(' 'keyword'=', ' 'uargs);if p>0 then args = overlay(' ', args, p+length(keyword));p = find(upper(args), keyword);end;system.cmdopt.keyword = p>0;select;when mode=0 then if p>0 then do;ret = 1;args = delword(args, p, 1);end;else ret = old;when mode=1 then if p>0 then do;left = subword(args, 1, p-1);rest = subword(args, p+1);if left(rest, 1)='"' then parse var rest . '"' ret '"' rest;else parse var rest ret rest;args = strip(left strip(rest));end;else ret = old;when mode=2 then do;if left(args, 1)='"' then parse var args . '"' ret '"' args;else parse var args ret args;if strip(ret)='' then ret = old;end;otherwise exit 99;end;args = strip(args);ret = strip(ret, 'b', '" ');return ret;Get_Datas: procedure Expose msg. system.;MM_GetAddrs 'system.addr';system.addresses = '';do n=0 to system.addr.count-1;system.addresses = system.addresses system.addr.n;end
upper system.addresses;msg.send = system.arg.file;tmp = 'AREA FLAGS FROM FROMADDR SUBJ TO TOADDR';do while tmp~='';parse var tmp field tmp;msg.field = '*';if system.arg.field~='' then msg.field = system.arg.field;end;if system.arg.gui then do;call Log('Asking for datas...',, 4);system.arg.mode = Request_Choice('What encoding-methode do you want to use?', '_FS-encode|_MIME|_Abort|*_UU-encode', 'FS MIME _ UU');if system.arg.mode='' then call Quit(5, 'Aborted by user!');end;if system.arg.gui then do;if msg.area='*' then do;MM_AreaReq 'msg.area';if RC~=0 then call Quit(5, 'Aborted by user!');end;do while msg.send='' | ~exists(msg.send);msg.send = path(pragma('d'));MM_FileReq 'msg.send';if RC=1 then call Quit(5, 'Aborted by user!');end;end;if ~exists(msg.send) then call Quit(11, 'Unable to locate "'msg.send'"!');if system.arg.gui & msg.area='' then do;MM_AreaReq 'msg.area';if RC=1 then call Quit(5, 'Aborted by user!');end;MM_GetAreaInfo msg.area 'msg.area.data'
if RC~=0 then call Quit(11, 'Unknown area "'msg.area'"!');msg.domain = Get_Domain(msg.area.data.addr);if system.arg.gui then do;ret = Request_Choice('Do you also want to send an introduction-msg?', ' _Use file |_Write now|* _NO ', '1 2 0');select;when ret=1 then do;system.arg.infofile = 'ff'x;do while ~exists(system.arg.infofile);system.arg.infofile = path(system.mm.tempdir);MM_FileReq 'system.arg.infofile';if RC=1 then call Quit(5, 'Aborted by user!');end;system.arg.delinfofile = Request_Choice('\c\nDelete \1'system.arg.infofile'\0 after posting?', ' _YES |* _NO ', '1 0');end;when ret=2 then do;system.arg.infofile = system.tmpfile'.inf';system.arg.delinfofile = 1;call Command(replace(system.mm.editor, system.arg.infofile, '%s'));end;otherwise nop;end;end;system.is_mail = msg.area.data.type='MAIL';system.is_echo = ~system.is_mail;if msg.toaddr='*' then if system.is_mail then if system.arg.gui then msg.toaddr = Get_Addr('To-Address');else call Quit(11, 'To-address missing!');else drop msg.toaddr
if msg.to='*' then if system.is_mail then msg.to = Get_Name(msg.toaddr);else msg.to = 'All';if system.arg.gui then msg.to = Request_String('To-name', msg.to, 1);if msg.fromaddr='*' & system.is_mail then if system.arg.gui then do;MM_GetAddrs 'tmp';req. = 0;do n=0 to tmp.count-1;if Get_Domain(tmp.n)=msg.domain then MM_AddToStem 'req' 'tmp.'n;end;select;when req.count=0 then call Quit(20, 'No valid source-#ADDRESS or #AKA for' system.fromaddr'!!!');when req.count=1 then msg.fromaddr = req.0;otherwise;do;RC = -99;tmp. = '';MM_SingleSelReq 'req' 'tmp' '"Address"' 'STR';if RC=1 then call Quit(5, 'Aborted by user!');if tmp.0~=''then msg.fromaddr = tmp.0;end;end;end;else msg.fromaddr = msg.area.data.addr;else msg.fromaddr = msg.area.data.addr;if msg.from='*' then tmp = Get_Name(msg.fromaddr);else tmp = msg.from;if system.arg.gui then tmp = Request_String('From-Name', tmp, 0);if tmp='' then drop msg.from;else msg.from = tmp;if msg.subj='*' then do;sfile = msg.send;p = lastpos('/', sfile)
if p>0 then sfile = substr(sfile, p+1);p = lastpos(':', sfile);if p>0 then sfile = substr(sfile, p+1);tmp = '';if system.arg.gui then sfile = Request_String('Subject', sfile, 1);msg.subj = sfile;end;if system.arg.gui & msg.flags='*' then do;msg.flags = '';if system.is_mail then do;req.0 = 'CRASH';req.1 = 'HOLD';req.2 = 'KILL';req.3 = 'RRR';req.count = 4;end;else;do;req.0 = 'KILL';req.count = 1;end;tmp. = 0;MM_MultiSelReq 'req' 'tmp' '"Flags"' 'STR';if RC=1 & system.mm.release>=449 then call Quit(5, 'Aborted by user!');do n=0 to tmp.count-1;msg.flags = msg.flags tmp.n;end;end;return;Get_Domain: procedure;arg . '@' dmn '.' .;return dmn;Get_Encoded_File: procedure Expose msg. system.;parse arg mode, area, msgnr, start, ende, open, offs;cont. = 0;if start=-1 then do;start = 0;cont.prev = 1;end;if ende=-1 then do;ende = msg.text.count-1;cont.next = 1;end;if cont.prev then if Search_Encoded(mode, 'BEGIN') then if result.0<ende then call Quit(20, 'Could not find end of encoded file!');if open then do
if ~open(out, system.tmpfile, 'w') then call Quit(30, 'Unable to open "'system.tmpfile'" for write!');tmp = start+offs+1;msg.enclen = length(msg.text.tmp);end;if ~cont.prev then do;if mode='MIME' then do n=start-2 to start;call writeln(out, msg.text.n);end;else call Write_Line(start, 0);msg.text.start = '*** DONE ***';end;else call Write_Line(start, 1);fail = 0;last = 0;do n=start+1 to ende-1;check = (cont.prev & cont.next) | (n>start+offs & n<ende-2) | (cont.next & n>start+2) | (cont.prev & n<ende-2);ret = Write_Line(n, check);fail = fail+~ret;if ret then do;fail = 0;last = n;end;if fail~=20 then iterate;cont.next = 0;ende = last+1;leave;end;call Write_Line(ende, cont.next);msg.text.ende = msg.text.start;tmp = ende+1;if mode='UU' & upper(left(msg.text.tmp, 4))='SIZE' then call writeln(out, msg.text.tmp);if cont.next then do;msgnr = msgnr+1;if msgnr>system.ainfo.himsg then if mode~='MIME' then call Quit(20, 'Could not find end of encoded file!');else call Write_Line(last+1, 0);else;do
call Read_Msg(area, msgnr, 'Could not find end of encoded file!');call Search_Encoded(mode, 'END');if result.count=0 then ende = -1;else ende = result.0;msgnr = Get_Encoded_File(mode, area, msgnr, -1, ende, 0, 2);end;end;if open then call close(out);return msgnr;Get_Name: procedure Expose msg. system.;parse arg address;MM_GetNodelistNode address 'tmp';if rc>0 then if find(system.addresses, upper(address))>0 then if system.mm.release<429 then do; MM_GetSysop 'ret'; end;else ret = msg.area.data.alias;else ret = 'Sysop';else ret = tmp.sysop;return ret;Get_Version: procedure;parse arg mode;parse value sourceline(3-mode) with . . ver .;parse var ver tst 'ß' .;if ~datatype(strip(tst, 'b', '/ce '), 'N') then if ~mode then ver = Get_Version(1);else exit 99;return ver;Header:;call Log(,'/',, 3);call Log('***' system.prg.id '***', '+');call Log(system.prg.cr);call Log(,, 3);return;Include_Lib: procedure;parse arg lib, prio;if right(upper(lib), 8)~='.LIBRARY' then lib=lib'.library';if prio='' then prio=0
when must then system.arg.keyword = '0'x;when bool then system.arg.keyword = 0;when num then system.arg.keyword = 0;otherwise system.arg.keyword = '';end;if bool | key then mode = ~bool;else mode = 2;system.arg.keyword = Get_Arg(keyword, mode, system.arg.keyword);if must & system.arg.keyword='0'x then do;tmp = template 'missing!!!';say;say ' ***' tmp '***';signal Usage;end;if num & ~datatype(system.arg.keyword, 'N') then do;tmp = 'Numeric value expected for' template', but is "'system.arg.keyword'"!!!';say;say ' ***' tmp '***';signal Usage;end;end;drop mode;tmp = '?'; if system.arg.tmp then signal Usage;if args~='' then call Quit(10, 'Unknown option(s):' args);if system.arg.decode then if system.arg.encode | system.arg.area='' | system.arg.msg='' then signal Usage;else nop;else;do;upper system.arg.mode;if ~system.arg.gui & system.arg.area='' then signal Usage;if ~system.arg.gui & find('FS MIME UU', system.arg.mode)=0 then signal Usage;if system.arg.infofile~='' then do
system.arg.infofile = Expand_Path(system.arg.infofile);if ~exists(system.arg.infofile) then call Quit(11, system.arg.infofile 'does not exist!');end;end;if system.arg.maxsize>0 then if system.arg.maxsize<10000 then call Quit(11, 'Invalid value for MAXSIZE/K/N "'system.arg.maxsize'"!');else;do;tmp = system.arg.mode;system.tmp.maxsize = system.arg.maxsize;end;return;Quit:;parse arg return_code, error_msg;error_line = 0;rc = 0;signal Exit;Read_Cfg: procedure Expose system.;MM_ReadStem system.prg.cfg 'cfg';if RC~=0 then call Quit(31, 'Unable to read' system.prg.cfg'!!!');call Log('Reading config...');cnt = 0;do l=0 to cfg.count-1;parse value strip(translate(cfg.l, ' ', '9'x)) with key args ';' .;key = upper(strip(key));args = strip(args);select;when key='' then iterate;when key='#FSDECODE' then system.cmd.fs.decode = args;when key='#FSENCODE' then system.cmd.fs.encode = args;when key='#FSMAXSIZE' then if datatype(args, 'N') & args>=10000 then system.fs.maxsize = args
else call Quit(11, 'Invalid value "'args'" for #FSMAXSIZE at line' l'!');when key='#MIMEDECODE' then system.cmd.mime.decode = args;when key='#MIMEENCODE' then system.cmd.mime.encode = args;when key='#MIMEMAXSIZE' then if datatype(args, 'N') & args>=10000 then system.mime.maxsize = args;else call Quit(11, 'Invalid value "'args'" for #MIMEMAXSIZE at line' l'!');when key='#UUDECODE' then system.cmd.uu.decode = args;when key='#UUENCODE' then system.cmd.uu.encode = args;when key='#UUMAXSIZE' then if datatype(args, 'N') & args>=10000 then system.uu.maxsize = args;else call Quit(11, 'Invalid value "'args'" for #UUMAXSIZE at line' l'!');when key='#OUTDIR' then system.prg.dir = path(args);when key='#NOCLEARNEW' then nop;when key='#CLEARNEW' then system.clearnew = 1;otherwise say '*** CFG-ERROR: Unknown keword "'key'" at line' l'!!!';end;cnt = cnt+1;end;if cnt~=11 then call Quit(10, 'Required config-argument(s) missing!');system.tmpdir = system.prg.dir || system.prg.name'/'
system.tmpfile = system.prg.dir || system.prg.name'.tmp';return;Read_Msg: procedure Expose msg. system.;parse arg area, nr, errtxt;call Log('Processing' area', msg #'nr'...',, 4);MM_ReadMsg area nr 'msg';if RC~=0 then call Quit(20, errtxt);MM_AddToStem 'system.msg' 'nr';return;Replace: procedure;parse arg string,new,old;do while index(string, old)>0;interpret "parse var string l '"old"' r";string = l || new || r;end;return string;Request_Choice: procedure Expose system.;parse arg text, buttons, ret_vals;title = system.prg.name'-Requester';text = translate(Replace(text, '0A'x, '\n'), '1b'x, '\');if length(text)<40 then text = center(text, 40);MM_Requester title 'text' 'buttons';if rc=0 then rc=words(ret_vals);return compress(word(ret_vals, rc), '_');Request_String: procedure Expose RC system.;parse arg txt, value, force;old = value;do until ~force;MM_StringReq '"'txt'"' 'value';if RC=1 then call Quit(5, 'Aborted by user!');value = strip(value);force = force & value='';end;return value
